home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Atari Mega Archive 1
/
Atari Mega Archive - Volume 1.iso
/
gnu
/
emacs
/
emacs1857
/
src_d2.zoo
/
source
/
fileio.c
< prev
next >
Wrap
C/C++ Source or Header
|
1991-12-02
|
63KB
|
2,472 lines
/* File IO for GNU Emacs.
Copyright (C) 1985, 1986, 1987, 1988, 1990 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING. If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
/**
** (sjk++) we need the fcntl flags on the ST.
**/
#ifdef atarist
#include <fcntl.h>
#endif
#include <sys/types.h>
#ifdef hpux
/* needed by <pwd.h> */
#include <stdio.h>
#undef NULL
#endif
#include <sys/stat.h>
#include <pwd.h>
#include <ctype.h>
#include <sys/dir.h>
#include <errno.h>
#ifndef VMS
extern int errno;
extern char *sys_errlist[];
extern int sys_nerr;
#endif
#define err_str(a) ((a) < sys_nerr ? sys_errlist[a] : "unknown error")
#ifdef APOLLO
#include <sys/time.h>
#endif
#ifdef NULL
#undef NULL
#endif
#include "config.h"
#include "lisp.h"
#include "buffer.h"
#include "window.h"
#ifdef VMS
#include <perror.h>
#include <file.h>
#include <rmsdef.h>
#include <fab.h>
#include <nam.h>
#endif
#ifdef HAVE_TIMEVAL
#ifdef HPUX
#include <time.h>
#else
#include <sys/time.h>
#endif
#endif
#ifdef HPUX
#include <netio.h>
#include <errnet.h>
#endif
#ifndef O_WRONLY
#define O_WRONLY 1
#endif
#define min(a, b) ((a) < (b) ? (a) : (b))
#define max(a, b) ((a) > (b) ? (a) : (b))
/* Nonzero during writing of auto-save files */
int auto_saving;
/* Nonzero means, when reading a filename in the minibuffer,
start out by inserting the default directory into the minibuffer. */
int insert_default_directory;
/* On VMS, nonzero means write new files with record format stmlf.
Zero means use var format. */
int vms_stmlf_recfm;
Lisp_Object Qfile_error, Qfile_already_exists;
report_file_error (string, data)
char *string;
Lisp_Object data;
{
Lisp_Object errstring;
if (errno >= 0 && errno < sys_nerr)
errstring = build_string (sys_errlist[errno]);
else
errstring = build_string ("undocumented error code");
/* System error messages are capitalized. Downcase the initial. */
XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]);
while (1)
Fsignal (Qfile_error,
Fcons (build_string (string), Fcons (errstring, data)));
}
DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
1, 1, 0,
"Return the directory component in file name NAME.\n\
Return nil if NAME does not include a directory.\n\
Otherwise returns a directory spec.\n\
Given a Unix syntax file name, returns a string ending in slash;\n\
on VMS, perhaps instead a string ending in :, ] or >.")
(file)
Lisp_Object file;
{
register unsigned char *beg;
register unsigned char *p;
CHECK_STRING (file, 0);
beg = XSTRING (file)->data;
p = beg + XSTRING (file)->size;
while (p != beg && p[-1] != '/'
#ifdef VMS
&& p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
#endif /* VMS */
) p--;
if (p == beg)
return Qnil;
return make_string (beg, p - beg);
}
DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, Sfile_name_nondirectory,
1, 1, 0,
"Return file name NAME sans its directory.\n\
For example, in a Unix-syntax file name,\n\
this is everything after the last slash,\n\
or the entire name if it contains no slash.")
(file)
Lisp_Object file;
{
register unsigned char *beg, *p, *end;
CHECK_STRING (file, 0);
beg = XSTRING (file)->data;
end = p = beg + XSTRING (file)->size;
while (p != beg && p[-1] != '/'
#ifdef VMS
&& p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
#endif /* VMS */
) p--;
return make_string (p, end - p);
}
char *
file_name_as_directory (out, in)
char *out, *in;
{
int size = strlen (in) - 1;
strcpy (out, in);
#ifdef VMS
/* Is it already a directory string? */
if (in[size] == ':' || in[size] == ']' || in[size] == '>')
return out;
/* Is it a VMS directory file name? If so, hack VMS syntax. */
else if (! index (in, '/')
&& ((size > 3 && ! strcmp (&in[size - 3], ".DIR"))
|| (size > 3 && ! strcmp (&in[size - 3], ".dir"))
|| (size > 5 && (! strncmp (&in[size - 5], ".DIR", 4)
|| ! strncmp (&in[size - 5], ".dir", 4))
&& (in[size - 1] == '.' || in[size - 1] == ';')
&& in[size] == '1')))
{
register char *p, *dot;
char brack;
/* x.dir -> [.x]
dir:x.dir --> dir:[x]
dir:[x]y.dir --> dir:[x.y] */
p = in + size;
while (p != in && *p != ':' && *p != '>' && *p != ']') p--;
if (p != in)
{
strncpy (out, in, p - in);
out[p - in] = '\0';
if (*p == ':')
{
brack = ']';
strcat (out, ":[");
}
else
{
brack = *p;
strcat (out, ".");
}
p++;
}
else
{
brack = ']';
strcpy (out, "[.");
}
if (dot = index (p, '.'))
{
/* blindly remove any extension */
size = strlen (out) + (dot - p);
strncat (out, p, dot - p);
}
else
{
strcat (out, p);
size = strlen (out);
}
out[size++] = brack;
out[size] = '\0';
}
#else /* not VMS */
/* For Unix syntax, Append a slash if necessary */
if (out[size] != '/')
strcat (out, "/");
#endif /* not VMS */
return out;
}
DEFUN ("file-name-as-directory", Ffile_name_as_directory,
Sfile_name_as_directory, 1, 1, 0,
"Return a string representing file FILENAME interpreted as a directory.\n\
This string can be used as the value of default-directory\n\
or passed as second argument to expand-file-name.\n\
For a Unix-syntax file name, just appends a slash.\n\
On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
(file)
Lisp_Object file;
{
char *buf;
CHECK_STRING (file, 0);
if (NULL (file))
return Qnil;
buf = (char *) alloca (XSTRING (file)->size + 10);
return build_string (file_name_as_directory (buf, XSTRING (file)->data));
}
/*
* Convert from directory name to filename.
* On VMS:
* xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
* xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
* On UNIX, it's simple: just make sure there is a terminating /
* Value is nonzero if the string output is different from the input.
*/
directory_file_name (src, dst)
char *src, *dst;
{
long slen;
#ifdef VMS
long rlen;
char * ptr, * rptr;
char bracket;
struct FAB fab = cc$rms_fab;
struct NAM nam = cc$rms_nam;
char esa[NAM$C_MAXRSS];
#endif /* VMS */
slen = strlen (src) - 1;
#ifdef VMS
if (! index (src, '/')
&& (src[slen] == ']' || src[slen] == ':' || src[slen] == '>'))
{
/* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
fab.fab$l_fna = src;
fab.fab$b_fns = slen + 1;
fab.fab$l_nam = &nam;
fab.fab$l_fop = FAB$M_NAM;
nam.nam$l_esa = esa;
nam.nam$b_ess = sizeof esa;
nam.nam$b_nop |= NAM$M_SYNCHK;
/* We call SYS$PARSE to handle such things as [--] for us. */
if (SYS$PARSE(&fab, 0, 0) == RMS$_NORMAL)
{
slen = nam.nam$b_esl - 1;
if (esa[slen] == ';' && esa[slen - 1] == '.')
slen -= 2;
esa[slen + 1] = '\0';
src = esa;
}
if (src[slen] != ']' && src[slen] != '>')
{
/* what about when we have logical_name:???? */
if (src[slen] == ':')
{ /* Xlate logical name and see what we get */
ptr = strcpy (dst, src); /* upper case for getenv */
while (*ptr)
{
if ('a' <= *ptr && *ptr <= 'z')
*ptr -= 040;
ptr++;
}
dst[slen] = 0; /* remove colon */
if (!(src = egetenv (dst)))
return 0;
/* should we jump to the beginning of this procedure?
Good points: allows us to use logical names that xlate
to Unix names,
Bad points: can be a problem if we just translated to a device
name...
For now, I'll punt and always expect VMS names, and hope for